Cream of the Crop 1/Cream of the Crop 1.iso/PROGRAM/WEDITS22.ARJ/WEKBD.PAS

Pascal/Delphi Source File | 1991-08-13 | 5KB | 230 lines

UNIT WEKbd;
{ -- This is the Low Level Keyboard Module for WWIVEdit 2.2
  -- Last Modified : 8/13/91
  -- Written By:
  --   Adam Caldwell
  --
  -- This Code is Limited Public Domain (see WWIVEDIT.PAS for details)
  --
  -- Purpose : Provides low level, buffered keyboard input routines
  --
  -- Know Errors: Will lock up a computer if the user hangs up while
  --  seperate_local_input is on.  This only occurs during chat mode.
  --
  -- Planned Enhancements : Implementing fix described in WECHAT.PAS
  --
  -- }
{$R-,V-,S-,B-,E-,N-}   { These Optomize things as much as possible }

INTERFACE

VAR
  TrueKeyboard : BOOLEAN;       { True if ANY key is pressed on the local keyboard }


PROCEDURE Drain;
FUNCTION  ReadKey:char;
FUNCTION  KeyPressed:boolean;
FUNCTION  Empty:boolean;
PROCEDURE SeperateLocalInput;
PROCEDURE MergeLocalInput;
FUNCTION  KeyPressedL:boolean;
FUNCTION  ReadKeyL:char;
PROCEDURE StuffIn(s:string);

IMPLEMENTATION

USES DOS,WEVars;

CONST
  BufferSize = 1024;

TYPE
  KeyBuffer = RECORD
      Buffer : ARRAY[0..Buffersize-1] OF char;
      head : integer;
      tail : integer;
  END;

VAR
  LKeyBuffer : KeyBuffer;  { Local Key Buffer - when active }
  RKeyBuffer : KeyBuffer;  { Remote Key Buffer }
  KbdHead : WORD ABSOLUTE $40:$1a;
  KbdTail : WORD ABSOLUTE $40:$1c;
  KbdMin : WORD ABSOLUTE $40:$80;
  KbdMax : WORD ABSOLUTE $40:$82;
  OldDos    : pointer;
  installedInt9 :boolean;
  OldInt9 : pointer;
  InDos : boolean;



PROCEDURE Enque(VAR b:KeyBuffer; ch:char);
BEGIN
  WITH B DO BEGIN
    buffer[tail]:=ch;
    tail:=(tail+1) MOD BufferSize;
  END
END;

FUNCTION DosEmptyKeyBuffer : boolean;
VAR
  empty:boolean;
  r : registers;
BEGIN
  IF KbdHead<>KbdTail THEN TrueKeyboard:=TRUE;
  r.ah:=$06;
  r.dl:=$FF;
  msdos(r);
  Empty:=(r.flags AND FZero) >0;
  IF not Empty THEN Enque(RKeyBuffer,chr(r.al));
  DosEmptyKeyBuffer := Empty;
END;

PROCEDURE Drain;
BEGIN
  WHILE NOT DosEmptyKeyBuffer DO ;
END;

FUNCTION EmptyBuffer(VAR B:KeyBuffer):boolean;
BEGIN
  EmptyBuffer:=b.head=b.tail
END;



FUNCTION DeQue(VAR b:KeyBuffer):char;
BEGIN
  WITH B DO BEGIN
    DeQue:=buffer[head];
    head:=(head+1) MOD BufferSize
  END
END;


FUNCTION KeyPressedL:boolean;
BEGIN
  KeyPressedL:=NOT EmptyBuffer(LKeyBuffer)
END;

FUNCTION ReadKeyL:char;
BEGIN
  REPEAT UNTIL KeyPressedL;
  ReadKeyL:=DeQue(LKeyBuffer);
END;

PROCEDURE NewInt9;
INTERRUPT;
BEGIN
  inline( $9C/ $FF/ $1E/ OldInt9 ); { Pushf / Call Far [OldInt9] }
  IF KbdHead<>KbdTail THEN
  BEGIN
    WITH LKeyBuffer DO BEGIN
      buffer[tail]:=chr(Mem[$40:KbdHead]);
      tail:=(tail+1) MOD BufferSize;
    END;
    IF Mem[$40:KbdHead]=0 THEN
    WITH LKeyBuffer DO BEGIN
      buffer[tail]:=chr(Mem[$40:KbdHead+1]);
      tail:=(tail+1) MOD BufferSize;
    END;
    KbdHead:=KbdHead+2;
    IF KbdHead=KbdMax THEN KbdHead:=KbdMin;
  END;
END;

PROCEDURE MergeLocalInput;
BEGIN
  IF InstalledInt9 THEN
  BEGIN
    SetIntVec(9,OldInt9);
    InstalledInt9:=FALSE;
  END;
END;


PROCEDURE SeperateLocalInput;
BEGIN
  IF NOT InstalledInt9 THEN
  BEGIN
    GetIntVec(9,OldInt9);
    SetIntVec(9,@NewInt9);
    InstalledInt9:=TRUE;
    LKeyBuffer.Head:=LKeyBuffer.Tail;
    RKeyBuffer.Head:=RKeyBuffer.Tail;
  END;
END;

FUNCTION empty : boolean;
BEGIN
  empty  :=  DosEmptyKeyBuffer AND EmptyBuffer(RKeyBuffer);
END;


FUNCTION KeyPressed : boolean;
BEGIN
  IF KbdHead<>KbdTail THEN TrueKeyboard:=TRUE;
  keypressed  :=  not empty
END;

PROCEDURE StuffIn(s:string);
VAR i:integer;
BEGIN
  FOR i:=1 TO length(s) DO
    Enque(RKeyBuffer,s[i]);
END;

PROCEDURE WriteKeyBuffer(ch:char);
VAR
  r:registers;
BEGIN
  IF KeyBIOS THEN BEGIN
    r.ah:=5; r.cl:=ord(ch);
    intr($16,r);
  END
  ELSE BEGIN
    Mem[$40:KbdTail]:=ord(ch);
    Mem[$40:KbdTail+1]:=0;
    KbdTail:=KbdTail+2;
    IF KbdTail=KbdMax THEN KbdTail:=KbdMin;
  END;
END;

FUNCTION Macro(ch:char):char;
VAR r:registers;
BEGIN
  WriteKeyBuffer(^P);
  WriteKeyBuffer(ch);
  r.ah  :=  $07;  msdos(r);
  Macro:=chr(r.al);
END;

FUNCTION ReadKey : char;
VAR
  ch : char;
  r : registers;
BEGIN
  IF KbdHead<>KbdTail THEN TrueKeyboard:=TRUE;
  REPEAT
    IF EmptyBuffer(RKeyBuffer) THEN
    BEGIN
      r.ah  :=  $07;
      msdos(r);
      Enque(RKeyBuffer,chr(r.al));
    END;
    Ch:=Deque(RKeyBuffer);
    IF (ch IN [^A,^D,^F]) AND (NOT InDos) THEN ch:=Macro(ch);
  UNTIL NOT (ch IN [^A,^D,^F]);
  ReadKey:=ch;
END;

BEGIN
  LKeyBuffer.Head:=0;
  LKeyBuffer.Tail:=0;
  RKeyBuffer.Head:=0;
  RKeyBuffer.Tail:=0;
  TrueKeyboard:=FALSE;
  InstalledInt9:=FALSE;
  InDos:=GetEnv('BBS')='';
END.